Visual Basic Source Code/Visual Basic Source Code.iso/vbsource/datamgr/dataform.frm

Text File | 1993-04-20 | 19KB | 729 lines

VERSION 2.00
Begin Form DataForm
   BackColor       =   &H00C0C0C0&
   ClientHeight    =   3960
   ClientLeft      =   630
   ClientTop       =   1755
   ClientWidth     =   8475
   Height          =   4365
   Icon            =   DATAFORM.FRX:0000
   Left            =   570
   LinkTopic       =   "Form2"
   MDIChild        =   -1  'True
   ScaleHeight     =   3960
   ScaleWidth      =   8475
   Top             =   1410
   Width           =   8595
   Begin PictureBox StatBox
      Align           =   2  'Align Bottom
      BackColor       =   &H00C0C0C0&
      BorderStyle     =   0  'None
      Height          =   270
      Left            =   0
      ScaleHeight     =   282.462
      ScaleMode       =   0  'User
      ScaleWidth      =   8490.27
      TabIndex        =   5
      Top             =   3690
      Width           =   8475
      Begin Data Data1
         Connect         =   ""
         DatabaseName    =   ""
         Exclusive       =   0   'False
         Height          =   270
         Left            =   0
         Options         =   0
         ReadOnly        =   0   'False
         RecordSource    =   ""
         Top             =   0
         Width           =   5475
      End
   End
   Begin VScrollBar cScrollBar
      Height          =   2085
      LargeChange     =   3500
      Left            =   7665
      SmallChange     =   350
      TabIndex        =   14
      Top             =   630
      Visible         =   0   'False
      Width           =   255
   End
   Begin PictureBox cFields
      BackColor       =   &H00C0C0C0&
      BorderStyle     =   0  'None
      Height          =   1065
      Left            =   0
      ScaleHeight     =   1056.48
      ScaleMode       =   0  'User
      ScaleWidth      =   7600.262
      TabIndex        =   9
      TabStop         =   0   'False
      Top             =   630
      Width           =   7605
      Begin TextBox cFieldData
         BackColor       =   &H00FFFFFF&
         DataSource      =   "Data1"
         ForeColor       =   &H00000000&
         Height          =   285
         Index           =   0
         Left            =   1679
         TabIndex        =   12
         Top             =   0
         Visible         =   0   'False
         Width           =   3255
      End
      Begin CheckBox cFieldCheck
         BackColor       =   &H00C0C0C0&
         DataSource      =   "Data1"
         Height          =   330
         Index           =   0
         Left            =   1679
         TabIndex        =   11
         Top             =   735
         Visible         =   0   'False
         Width           =   3270
      End
      Begin PictureBox cFieldPicture
         DataSource      =   "Data1"
         Height          =   282
         Index           =   0
         Left            =   1679
         ScaleHeight     =   255
         ScaleWidth      =   3240
         TabIndex        =   10
         Top             =   315
         Visible         =   0   'False
         Width           =   3270
      End
      Begin Label cFieldName
         BackColor       =   &H00C0C0C0&
         ForeColor       =   &H00000000&
         Height          =   225
         Index           =   0
         Left            =   105
         TabIndex        =   13
         Top             =   0
         Visible         =   0   'False
         Width           =   1515
      End
   End
   Begin PictureBox FieldHeader
      Align           =   1  'Align Top
      BackColor       =   &H00C0C0C0&
      BorderStyle     =   0  'None
      Height          =   300
      Left            =   0
      ScaleHeight     =   300
      ScaleMode       =   0  'User
      ScaleWidth      =   8480.059
      TabIndex        =   6
      Top             =   330
      Width           =   8475
      Begin Label FieldValueLabel
         BackColor       =   &H00C0C0C0&
         Caption         =   " Value:"
         Height          =   252
         Left            =   1680
         TabIndex        =   8
         Top             =   30
         Width           =   2652
      End
      Begin Label FieldHdrLabel
         BackColor       =   &H00C0C0C0&
         Caption         =   "Field Name:"
         Height          =   252
         Left            =   120
         TabIndex        =   7
         Top             =   30
         Width           =   1212
      End
   End
   Begin PictureBox TopPic
      Align           =   1  'Align Top
      BackColor       =   &H00C0C0C0&
      BorderStyle     =   0  'None
      Height          =   330
      Left            =   0
      ScaleHeight     =   330
      ScaleWidth      =   8475
      TabIndex        =   0
      Top             =   0
      Width           =   8475
      Begin CommandButton RefreshBtn
         Caption         =   "&Refresh"
         Height          =   260
         Left            =   4680
         TabIndex        =   15
         Top             =   0
         Width           =   1215
      End
      Begin CommandButton FindBtn
         Caption         =   "&Find"
         Height          =   260
         Left            =   3480
         TabIndex        =   4
         Top             =   0
         Width           =   1215
      End
      Begin CommandButton DeleteBtn
         Caption         =   "&Delete"
         Height          =   260
         Left            =   2280
         TabIndex        =   3
         Top             =   0
         Width           =   1215
      End
      Begin CommandButton AddBtn
         Caption         =   "&Add"
         Height          =   260
         Left            =   0
         TabIndex        =   2
         Top             =   0
         Width           =   1215
      End
      Begin CommandButton UpdateBtn
         Caption         =   "&Update"
         Height          =   260
         Left            =   1200
         TabIndex        =   1
         Top             =   0
         Width           =   1095
      End
   End
End
Dim FldArr() As control

Dim FDS As Dynaset
Dim numFlds As Integer
Dim CurrField As Integer
Dim JustUsedFind As Integer        'flag for find function
Dim fResizing As Integer           'flag to avoid resize recursion

Dim FldTop As Integer

Const EM_NOTHING = 0
Const EM_EDIT = 1
Const EM_ADDNEW = 2

Const FT_TRUEFALSE = 1
Const FT_BYTE = 2
Const FT_INTEGER = 3
Const FT_LONG = 4
Const FT_CURRENCY = 5
Const FT_SINGLE = 6
Const FT_DOUBLE = 7
Const FT_DATETIME = 8
Const FT_STRING = 10
Const FT_BINARY = 11
Const FT_MEMO = 12

Const YES = 6
Const MSGBOX_TYPE = 4 + 48

Sub AddBtn_Click ()
  On Error GoTo AddErr

    data1.Caption = "Entering New Record"
  If AddBtn.Tag = "Disabled" Then
    EnableAllControls
  End If
  data1.Recordset.AddNew
  FldArr(0).SetFocus
  Exit Sub

AddErr:
  MsgBox Error$
  Resume AddEnd
AddEnd:

End Sub

Sub cFieldPicture_Click (Index As Integer)
  'this toggles the size of a picture control
  'so it mat be viewed or compressed
  If cFieldPicture(Index).Height <= 280 Then
    cFieldPicture(Index).AutoSize = True
  Else
    cFieldPicture(Index).AutoSize = False
    cFieldPicture(Index).Height = 280
  End If
End Sub

Sub cFieldPicture_DblClick (Index As Integer)
  On Error GoTo PicErr

  st = InputBox("Enter Picture FilName:")
  If st <> "" Then
    cFieldPicture(Index).Picture = LoadPicture(st)
  End If

  GoTo PicEnd

PicErr:
  MsgBox Error$
  Resume PicEnd

PicEnd:

End Sub

Sub cScrollBar_Change ()
  Dim t As Integer

  t = cScrollBar
  If (t - FldTop) Mod 350 = 0 Then
    cFields.Top = t
  Else
    cFields.Top = ((t - FldTop) \ 350) * 350 + FldTop
  End If

End Sub

Sub Data1_Error (dataerr As Integer, response As Integer)
  If dataerr = 3021 Then
    response = 0
  ElseIf dataerr = 481 Or dataerr = 321 Then 'Invalid picture
    response = 0
  Else
    MsgBox "Error:  " + Error$(dataerr)
    response = 0
  End If
End Sub

Sub data1_Reposition ()
    'if n